2016년 관중수가 800만명을 돌파한 프로야구는, 명실공히 한국 프로스포츠 최고의 인기 종목입니다.
프로야구의 인기와 더불어 데이터 분석에 대한 인식이 높아짐에 따라 국내 여러 구단에서 데이터 사이언스 역할의 수요가 늘고 있습니다.
특히 야구에서는 특정 선수의 성적 변동성이 해마다 매우 크기 때문에 내년 성적을 예측하기 까다로운 부분이 많습니다.
정말 못할 것이라고 생각했던 선수도 막상 내년에는 잘하고,
많은 지표가 리그 상위권이었던 선수가 내년에는 그렇지 않은 경우가 많습니다.
본 대회는 야구 데이터로 불확실성 문제를 해결하기 위해 2019년 타자들의 상반기 성적 예측을 목표로 합니다.
출처 및 상세규칙 : Dacon 6th Competiton - Predicting OPS for KBO Batters
OPS는 ’On Base plus Slugging’의 약자로 말 그대로 출루율과 장타율을 더한 수치이다. OPS .900이상을 A급, 그 이하는 .100단위로 나누어 타자의 등급을 매기는 것이 일반적이다. OPS는 출루율과 장타율의 비중을 1대1로 둔다는 점에서 많은 비판을 받는데(득점, 즉 생산력에 있어서는 출루율이 장타율보다 좀 더 높은 연관성을 지닌다) 그럼에도 불구하고 이 용어가 지속적으로 사용되는 이유는 식의 간편성 때문이다. 보통의 많은 공식들이 복잡한 수식을 사용하는데 비해 OPS는 덧셈을 할 줄 아는 사람이라면 누구나 곧바로 타자의 등급을 매겨 볼 수 있다는 점에서 널리 사랑받고 있다.
출처 : 네이버 지식백과
Evaluation Method로 Weighted Root Mean Square Error(WRMSE)를 활용하며 공식은 아래와 같다.
options(scipen = 100)
if (!require(dplyr)) install.packages('dplyr')
if (!require(knitr)) install.packages('knitr')
if (!require(kableExtra)) install.packages('kableExtra')
if (!require(reshape2)) install.packages('reshape2')
if (!require(stringr)) install.packages('stringr')
if (!require(tm)) install.packages('tm')
if (!require(lubridate)) install.packages('lubridate')
if (!require(ggplot2)) install.packages('ggplot2')
if (!require(ggcorrplot)) install.packages('ggcorrplot')
if (!require(scales)) install.packages('scales')
if (!require(ggpubr)) install.packages('ggpubr')
if (!require(plotly)) install.packages('plotly')
if (!require(xgboost)) install.packages('xgboost')
if (!require(rvest)) install.packages('rvest')
regular_season <- read.csv('C:/Users/Mano/Desktop/새 폴더/Regular_Season_Batter.csv',
fileEncoding = 'UTF-8',
stringsAsFactor = F,
na.strings = '-')
regular_season_crawl <- read.csv('C:/Users/Mano/Desktop/새 폴더/season.csv',
stringsAsFactor = F,
na.strings = '-')
day_by_day <- read.csv('C:/Users/Mano/Desktop/새 폴더/Regular_Season_Batter_Day_By_Day.csv',
fileEncoding = 'UTF-8',
stringsAsFactor = F,
na.strings = '-')
| Column_name | Description |
|---|---|
| batter_id | 타자의 고유 아이디 |
| batter_name | 타자 이름 |
| year | 년도 |
| team | 소속팀 |
| avg | 타율 |
| G | 출전게임수 |
| AB | 타수(타석-볼넷-사구-희생번트-희생플라이) |
| R | 득점 |
| H | 안타(1루타+2루타+3루타+홈런) |
| 2B | 2루타 |
| 3B | 3루타 |
| HR | 홈런 |
| TB | 루타 수 |
| RBI | 타점 |
| SB | 도루 성공 |
| CS | 도루 실패 |
| BB | 볼넷 |
| HBP | 사구(몸에 맞는 볼) |
| SO | 삼진아웃 |
| GDP | 병살타 |
| SLG | 장타율 |
| OBP | 출루율 |
| E | 에러 |
| height/weight | 선수의 키/몸무게 |
| year_born | 선수의 생년월일 |
| position | 선수의 수비위치 |
| career | 선수의 커리어 |
| starting_salary | 선수의 한국프로야구 입단연봉 |
| OPS | OPS(OBP+SLG) |
| PA | 타석 |
| SAC | 희생번트 |
| SF | 희생플라이 |
| IBB | 고의4구 |
| MH | 멀티히트 |
| RISP | 득점권타율 |
| PH.BA | 대타타율 |
| XBH | 장타 |
| GO | 땅볼 |
| AO | 뜬공 |
| GO.AO | 땅볼/뜬공 |
| GW.RBI | 결승타 |
| BB.K | 볼넷/삼진 |
| P.PA | 투구수/타석 |
| ISOP | 순수장타율 |
| XR | 추정즉점 |
| GPA | (1.8x출루율+장타율) / 4 |
| Column_name | Description |
|---|---|
| batter_id | 타자의 고유 아이디 |
| batter_name | 타자 이름 |
| date | 날짜 |
| opposing_team | 상대 팀 |
| avg1 | 해당 경기 타율 |
| AB | 해당 경기 타수 |
| R | 해당 경기 득점 |
| H | 해당 경기 안타 |
| 2B | 해당 경기 2루타 |
| 3B | 해당 경기 3루타 |
| HR | 해당 경기 홈런 |
| RBI | 해당 경기 타점 |
| SB | 해당 경기 도루 성공 |
| CS | 해당 경기 도루 실패 |
| BB | 해당 경기 볼넷 |
| HBP | 해당 경기 사구 |
| SO | 해당 경기 삼진아웃 |
| GDP | 해당 경기 병살타 |
| avg2 | 시즌 누적 타율 |
| year | 년도 |
regular_season$height <- substr(regular_season$height.weight, 1, 5) %>%
str_remove('cm') %>%
as.numeric()
regular_season$weight <- substr(regular_season$height.weight, 7, 20) %>%
str_remove('kg') %>%
as.numeric()
regular_season$height.weight <- NULL
regular_season$year_born <- regular_season$year_born %>%
str_remove('년 ') %>%
str_remove('월 ') %>%
str_remove('일') %>%
ymd()
regular_season$age <- regular_season$year - year(regular_season$year_born) + 1
regular_season$hand <- ifelse(substr(regular_season$position, 1, 2) == '포수',
substr(regular_season$position, 6, 7),
substr(regular_season$position, 7, 8))
regular_season$position <- ifelse(substr(regular_season$position, 1, 1) == '포',
'포수',
substr(regular_season$position, 1, 3))
regular_season$starting_salary <- regular_season$starting_salary %>%
str_remove('만원') %>%
str_remove('0달러') %>%
as.numeric()
regular_season <- regular_season %>%
mutate(X1B = H - X2B - X3B - HR)
str(regular_season)
## 'data.frame': 2454 obs. of 33 variables:
## $ batter_id : int 0 1 1 1 1 1 1 2 2 2 ...
## $ batter_name : chr "가르시아" "강경학" "강경학" "강경학" ...
## $ year : int 2018 2011 2014 2015 2016 2017 2018 2013 2015 2016 ...
## $ team : chr "LG" "한화" "한화" "한화" ...
## $ avg : num 0.339 0 0.221 0.257 0.158 0.214 0.278 0 0.2 0 ...
## $ G : int 50 2 41 120 46 59 77 2 4 2 ...
## $ AB : int 183 1 86 311 101 84 245 2 5 3 ...
## $ R : int 27 0 11 50 16 17 42 0 0 0 ...
## $ H : int 62 0 19 80 16 18 68 0 1 0 ...
## $ X2B : int 9 0 2 7 3 2 11 0 1 0 ...
## $ X3B : int 0 0 3 4 2 1 1 0 0 0 ...
## $ HR : int 8 0 1 2 1 0 5 0 0 0 ...
## $ TB : int 95 0 30 101 26 22 96 0 2 0 ...
## $ RBI : int 34 0 7 27 7 4 27 0 0 0 ...
## $ SB : int 5 0 0 4 0 1 6 0 0 0 ...
## $ CS : int 0 0 0 3 0 1 3 0 0 0 ...
## $ BB : int 9 0 13 40 8 8 38 0 0 0 ...
## $ HBP : int 8 0 2 5 2 1 4 0 0 0 ...
## $ SO : int 25 1 28 58 30 19 59 0 0 1 ...
## $ GDP : int 3 0 1 3 5 1 7 0 0 0 ...
## $ SLG : num 0.519 0 0.349 0.325 0.257 0.262 0.392 0 0.4 0 ...
## $ OBP : num 0.383 0 0.337 0.348 0.232 0.29 0.382 0 0.2 0 ...
## $ E : int 9 1 6 15 7 4 2 0 0 0 ...
## $ year_born : Date, format: "1985-04-12" "1992-08-11" ...
## $ position : chr "내야수" "내야수" "내야수" "내야수" ...
## $ career : chr "쿠바 Ciego de Avila Maximo Gomez Baez(대)" "광주대성초-광주동성중-광주동성고" "광주대성초-광주동성중-광주동성고" "광주대성초-광주동성중-광주동성고" ...
## $ starting_salary: num NA 10000 10000 10000 10000 10000 10000 9000 9000 9000 ...
## $ OPS : num 0.902 0 0.686 0.673 0.489 0.552 0.774 0 0.6 0 ...
## $ height : num 177 180 180 180 180 180 180 180 180 180 ...
## $ weight : num 93 72 72 72 72 72 72 82 82 82 ...
## $ age : num 34 20 23 24 25 26 27 21 23 24 ...
## $ hand : chr "우타" "좌타" "좌타" "좌타" ...
## $ X1B : int 45 0 13 67 10 15 51 0 0 0 ...
regular_season_crawl <- regular_season_crawl %>%
mutate(X1B = H - X2B - X3B - HR)
str(regular_season_crawl)
## 'data.frame': 5091 obs. of 39 variables:
## $ YEAR : int 2002 2002 2002 2002 2002 2002 2002 2002 2002 2002 ...
## $ 선수명: chr "윤태수" "김동주" "송원국" "강인권" ...
## $ 팀명 : chr "두산" "두산" "두산" "두산" ...
## $ AVG : num 0.333 0.318 0.308 0.294 0.289 0.288 0.275 0.274 0.262 0.256 ...
## $ G : int 3 120 45 38 127 130 130 126 91 119 ...
## $ PA : int 3 487 70 56 484 548 488 403 179 469 ...
## $ AB : int 3 415 65 51 432 486 444 369 164 407 ...
## $ R : int 0 63 9 4 51 50 55 69 13 53 ...
## $ H : int 1 132 20 15 125 140 122 101 43 104 ...
## $ X1B : int 0 85 12 14 90 104 106 69 34 58 ...
## $ X2B : int 1 21 5 1 17 24 12 18 4 18 ...
## $ X3B : int 0 0 0 0 0 4 3 1 1 3 ...
## $ HR : int 0 26 3 0 18 8 1 13 4 25 ...
## $ TB : int 2 231 34 16 196 196 143 160 61 203 ...
## $ RBI : int 0 79 13 1 70 58 30 47 16 82 ...
## $ SAC : int 0 0 0 1 7 7 7 0 5 0 ...
## $ SF : int 0 7 0 0 3 6 3 2 0 7 ...
## $ AVG.1 : num 0.333 0.318 0.308 0.294 0.289 0.288 0.275 0.274 0.262 0.256 ...
## $ BB : int 0 52 5 4 37 44 31 26 10 50 ...
## $ IBB : int 0 2 0 0 1 0 0 1 1 3 ...
## $ HBP : int 0 13 0 0 5 5 3 6 0 5 ...
## $ SO : int 0 61 14 10 63 65 65 66 31 123 ...
## $ GDP : int 0 8 0 0 17 13 10 5 4 11 ...
## $ SLG : num 0.667 0.557 0.523 0.314 0.454 0.403 0.322 0.434 0.372 0.499 ...
## $ OBP : num 0.333 0.405 0.357 0.345 0.35 0.349 0.324 0.33 0.305 0.339 ...
## $ OPS : num 1 0.962 0.88 0.659 0.804 0.752 0.646 0.764 0.677 0.838 ...
## $ MH : int 0 32 3 3 32 40 30 27 6 24 ...
## $ RISP : num 0 0.283 0.381 0.235 0.321 0.244 0.19 0.295 0.167 0.32 ...
## $ PH.BA : num 0.5 0.25 0.368 0 0 0 0.375 0.167 0.429 0 ...
## $ XBH : int 1 47 8 1 35 36 16 32 9 46 ...
## $ GO : int 2 97 14 18 132 152 143 83 52 98 ...
## $ AO : int 0 132 17 8 115 135 117 121 38 89 ...
## $ GO.AO : num NA 0.73 0.82 2.25 1.15 1.13 1.22 0.69 1.37 1.1 ...
## $ GW.RBI: int 0 0 0 0 0 0 0 0 0 0 ...
## $ BB.K : num NA 0.85 0.36 0.4 0.59 0.68 0.48 0.39 0.32 0.41 ...
## $ P.PA : num 4.33 3.9 3.44 4.02 3.71 3.59 3.75 3.67 3.77 4.06 ...
## $ ISOP : num 0.333 0.239 0.215 0.02 0.164 0.115 0.047 0.16 0.11 0.243 ...
## $ XR : num 0.5 90.5 11.8 6.2 64.3 67.3 45.7 52.7 17 70 ...
## $ GPA : num 0.317 0.322 0.291 0.234 0.271 0.258 0.226 0.257 0.23 0.277 ...
day_by_day$date <- paste0(day_by_day$year, day_by_day$date) %>%
removePunctuation() %>%
ymd()
day_by_day <- day_by_day %>%
mutate(X1B = H - X2B - X3B - HR)
day_by_day <- day_by_day %>% arrange(batter_id, date)
test <- day_by_day %>% arrange(batter_id, date)
test <- test %>%
group_by(batter_id, year) %>%
select_if(is.integer) %>%
mutate_all(cumsum) %>%
rename_at(.funs = function(x) paste0(x, '2'),
.vars = c('AB', 'R', 'H', 'X1B', 'X2B', 'X3B', 'HR', 'RBI', 'SB',
'CS', 'BB', 'HBP', 'SO', 'GDP')) %>%
select(-c(batter_id, year))
day_by_day <- bind_cols(day_by_day, test)
rm(test)
str(day_by_day)
## 'data.frame': 109771 obs. of 37 variables:
## $ batter_id : int 0 0 0 0 0 0 0 0 0 0 ...
## $ batter_name : chr "가르시아" "가르시아" "가르시아" "가르시아" ...
## $ date : Date, format: "2018-03-03" "2018-03-24" ...
## $ opposing_team: chr "KIA" "NC" "NC" "넥센" ...
## $ avg1 : num 0.6 0.333 0 0.2 0.2 0.25 1 0.75 0.25 0.4 ...
## $ AB : int 5 3 4 5 5 4 3 4 4 5 ...
## $ R : int 2 1 0 0 1 0 1 1 0 1 ...
## $ H : int 3 1 0 1 1 1 3 3 1 2 ...
## $ X2B : int 1 0 0 0 0 0 1 0 0 0 ...
## $ X3B : int 0 0 0 0 0 0 0 0 0 0 ...
## $ HR : int 0 0 0 0 0 0 0 0 0 1 ...
## $ RBI : int 1 0 0 0 1 3 2 2 0 1 ...
## $ SB : int 0 0 0 0 0 0 0 0 1 0 ...
## $ CS : int 0 0 0 0 0 0 0 0 0 0 ...
## $ BB : int 0 1 0 0 0 0 0 1 0 1 ...
## $ HBP : int 0 0 0 0 0 0 0 0 0 0 ...
## $ SO : int 1 1 1 0 0 0 0 1 2 1 ...
## $ GDP : int 0 0 0 0 0 1 0 0 0 0 ...
## $ avg2 : num 0.269 0.333 0.143 0.167 0.176 0.19 0.345 0.394 0.393 0.395 ...
## $ year : int 2018 2018 2018 2018 2018 2018 2018 2018 2018 2018 ...
## $ X1B : int 2 1 0 1 1 1 2 3 1 1 ...
## $ batter_id1 : int 0 0 0 0 0 0 0 0 0 0 ...
## $ year1 : int 2018 2018 2018 2018 2018 2018 2018 2018 2018 2018 ...
## $ AB2 : int 5 8 12 17 22 26 29 33 37 42 ...
## $ R2 : int 2 3 3 3 4 4 5 6 6 7 ...
## $ H2 : int 3 4 4 5 6 7 10 13 14 16 ...
## $ X2B2 : int 1 1 1 1 1 1 2 2 2 2 ...
## $ X3B2 : int 0 0 0 0 0 0 0 0 0 0 ...
## $ HR2 : int 0 0 0 0 0 0 0 0 0 1 ...
## $ RBI2 : int 1 1 1 1 2 5 7 9 9 10 ...
## $ SB2 : int 0 0 0 0 0 0 0 0 1 1 ...
## $ CS2 : int 0 0 0 0 0 0 0 0 0 0 ...
## $ BB2 : int 0 1 1 1 1 1 1 2 2 3 ...
## $ HBP2 : int 0 0 0 0 0 0 0 0 0 0 ...
## $ SO2 : int 1 2 3 3 3 3 3 4 6 7 ...
## $ GDP2 : int 0 0 0 0 0 1 1 1 1 1 ...
## $ X1B2 : int 2 3 3 4 5 6 8 11 12 13 ...
regular_season_crawl$RBI <- NULL
regular_season_crawl$R <- NULL
all.equal(regular_season_crawl$XBH,
apply(regular_season_crawl %>% select(X2B, X3B, HR), 1, sum))
## [1] TRUE
regular_season_crawl$XBH <- NULL
regular_season_crawl %>%
select(PA, G, AB) %>%
pairs()
regular_season_crawl$AB <- NULL
regular_season_crawl$G <- NULL
ggplotly(regular_season_crawl %>%
ggplot() +
geom_point(aes(x = PA,
y = OPS,
col = ifelse(PA >= 100, 'Team', '4실'))) +
geom_vline(xintercept = 100,
col= 'red',
linetype = 'dotted') +
theme_bw() +
theme(legend.position = 'none') +
geom_smooth(aes(x = PA,
y = OPS),
method = 'auto'))
day_by_day %>%
ggplot() +
geom_point(aes(x = AB2,
y = avg2,
col = ifelse(AB2 >= 100, 'Team', '4실')),
alpha = .1) +
geom_vline(xintercept = 100,
col = 'red',
linetype = 'dotted') +
theme_bw() +
theme(legend.position = 'none')
regular_season_crawl100 <- regular_season_crawl %>%
filter(PA >= 100)
regular_season100 <- regular_season %>%
filter(AB >= 100)
regular_season100 %>% filter(OPS == 0) %>% select(batter_id, batter_name, year, OPS, avg)
## batter_id batter_name year OPS avg
## 1 234 이진영 1999 0 0.258
## 2 234 이진영 2000 0 0.247
## 3 270 정성훈 1999 0 0.292
## 4 270 정성훈 2000 0 0.260
regular_season100 <- regular_season100 %>% filter(OPS != 0)
ggplotly(regular_season_crawl %>%
group_by(YEAR) %>%
summarise(PA = sum(PA)) %>%
ggplot(aes(x = YEAR,
y = PA,
fill = PA)) +
geom_bar(stat = 'identity') +
scale_fill_gradient(low = 'black',
high = 'red') +
labs(x = '연도',
y = '타석 수',
title = '연도별 타석 수') +
theme_bw())
* 2015년 부터 팀당 경기수가 128경기(2014년 기준)에서 144경기(2015년 기준)으로 증가함에 따라 타석의 수가 10,000건 가량 증가했음을 확인할 수 있다. 타석 수가 증가함에 따라 다른 기록들의 빈도도 증가하기에, 이를 보정하기 위해 변수 탐색 시 빈도와 비율 두 가지 관점으로 접근한다.
regular_season_crawl100 %>%
select(X1B, X2B, X3B, HR, OPS) %>%
pairs()
quantile(regular_season_crawl100$X3B, probs = seq(0, 1, 0.1))
## 0% 10% 20% 30% 40% 50% 60% 70% 80% 90% 100%
## 0 0 0 0 0 1 1 2 2 3 17
vars <- c('YEAR', 'PA', 'H', 'X1B', 'X2B', 'X3B', 'HR')
mano <- regular_season_crawl100 %>%
select(vars) %>%
group_by(YEAR) %>%
summarise_all(.funs = sum)
ggplotly(melt(mano, id.vars = c('YEAR', 'PA', 'H')) %>%
ggplot(aes(x = YEAR,
y = value,
col = variable)) +
geom_point(aes(size = PA)) +
geom_line() +
labs(title = '연도 별 안타 빈도',
y = 'Freq') +
theme_bw())
mano <- mano %>%
mutate(X1B_ratio = X1B / H * 100,
X2B_ratio = X2B / H * 100,
HR_ratio = HR / H * 100) %>%
select(YEAR, ends_with('ratio'))
melt(mano, id.vars = 'YEAR') %>%
ggplot() +
geom_bar(aes(y = value,
x = YEAR,
fill = variable),
stat = "identity") +
geom_text(aes(x = YEAR,
y = round(value) - 4,
label = paste0(round(value), "%")),
colour = "black",
size = 3) +
scale_y_continuous(labels = dollar_format(suffix = "%",
prefix = "")) +
labs(y = "Percentage") +
theme_bw() +
theme(legend.position = "bottom",
legend.direction = "horizontal",
legend.title = element_blank())
regular_season_crawl100 %>%
select(BB, IBB, HBP, OPS) %>%
pairs()
vars <- c('YEAR', 'PA', 'BB', 'IBB', 'HBP')
mano <- regular_season_crawl100 %>%
select(vars) %>%
group_by(YEAR) %>%
summarise_all(.funs = sum)
ggplotly(melt(mano, id.vars = c('YEAR', 'PA')) %>%
ggplot(aes(x = YEAR,
y = value,
col = variable)) +
geom_point(aes(size = PA)) +
geom_line() +
labs(title = '연도 별 4구/고의4구/사구 빈도',
y = 'Freq') +
theme_bw())
vars <- c('YEAR', 'BB', 'IBB', 'HBP')
mano <- regular_season_crawl100 %>%
select(vars) %>%
group_by(YEAR) %>%
summarise_all(.funs = sum) %>%
mutate(BB_ratio = BB / (BB + IBB + HBP) * 100,
IBB_ratio = IBB / (BB + IBB + HBP) * 100,
HBP_ratio = HBP / (BB + IBB + HBP) * 100) %>%
select(YEAR, ends_with('_ratio'))
melt(mano, id.vars = 'YEAR') %>%
ggplot() +
geom_bar(aes(y = value,
x = YEAR,
fill = variable),
stat = "identity") +
geom_text(aes(x = YEAR,
y = round(value),
label = paste0(round(value), "%")),
colour = "black",
size = 3) +
scale_y_continuous(labels = dollar_format(suffix = "%",
prefix = "")) +
labs(y = "Percentage") +
theme_bw() +
theme(legend.position = "bottom",
legend.direction = "horizontal",
legend.title = element_blank())
regular_season_crawl100 %>%
select(SO, GO, AO, GO.AO, GDP, SAC, SF, OPS) %>%
cor() %>%
ggcorrplot(lab = T,
colors = c('red', 'white', 'blue'),
hc.order = F)
vars <- c('YEAR', 'PA', 'SO', 'GO', 'AO', 'GDP', 'SAC', 'SF')
mano <- regular_season_crawl100 %>%
select(vars) %>%
group_by(YEAR) %>%
summarise_all(.funs = sum)
ggplotly(melt(mano, id.vars = c('YEAR', 'PA')) %>%
ggplot(aes(x = YEAR,
y = value,
col = variable)) +
geom_point(aes(size = PA)) +
geom_line() +
labs(title = '연도 별 4구/고의4구/사구 빈도',
y = 'Freq') +
theme_bw())
regular_season_crawl100 %>%
select(AVG, SLG, OBP, RISP, PH.BA, ISOP, XR, GPA, OPS) %>%
cor() %>%
ggcorrplot(lab = T,
colors = c('red', 'white', 'blue'),
hc.order = T)
regular_season_crawl100 %>%
select(SLG, ISOP) %>%
pairs()
regular_season_crawl100$SLG <- NULL
my_comparisons <- list( c("우타", "양타"),
c("우타", "좌타"),
c("양타", "좌타"))
ggboxplot(data = regular_season100 %>%
filter(hand %in% c('우타', '양타', '좌타')),
x = 'hand',
y = 'OPS',
color = 'hand',
palette = "jco",
bxp.errorbar = TRUE) +
stat_boxplot(geom = 'errorbar',
data = regular_season100 %>%
filter(hand %in% c('우타', '양타', '좌타')),
aes(x = hand,
y = OPS,
color = hand)) +
stat_compare_means(comparisons = my_comparisons) +
stat_compare_means(label.y = 1.5) +
labs(x = '타격 유형') +
theme_bw()
my_comparisons <- list( c("내야수", "외야수"),
c("내야수", "포수"),
c("외야수", "포수"))
ggboxplot(data = regular_season100 %>%
filter(position %in% c('내야수', '외야수', '포수')),
x = 'position',
y = 'OPS',
color = 'position',
palette = "jco",
bxp.errorbar = TRUE) +
stat_boxplot(geom = 'errorbar',
data = regular_season100 %>%
filter(position %in% c('내야수', '외야수', '포수')),
aes(x = position,
y = OPS,
color = position)) +
stat_compare_means(comparisons = my_comparisons) +
stat_compare_means(label.y = 1.7) +
labs(x = '포지션') +
theme_bw()
regular_season %>%
filter(AB >= 100) %>%
ggplot(aes(x = starting_salary,
y = OPS)) +
stat_smooth(method = 'lm') +
geom_point() +
theme_bw()
# Data Loading
season <- read.csv('C:/Users/Mano/Desktop/새 폴더/season_fin.csv') %>%
arrange(batter_id, desc(YEAR)) %>%
mutate(X1B = H - X2B - X3B - HR)
submission <- read.csv('C:/Users/Mano/Desktop/새 폴더/submission.csv',fileEncoding = 'UTF-8') %>%
arrange(batter_id)
submission2 <- season %>% filter(batter_id %in% submission$batter_id) %>% group_by(batter_id) %>% tally %>% filter(n==1)
# Trial 2(AB_y1 weight,2002~2018,100PA 기준)
stan_Trial2 <- season %>%
filter(batter_id %in% submission$batter_id) %>%
arrange(batter_id, desc(YEAR)) %>%
group_by(batter_id) %>%
summarise(PA_2018 = nth(PA, 1)) %>%
filter(PA_2018 > 99)
# XGB1 : 1개년도 사용해서 100타석 이상(AB_y1 weight)----
train <- list()
for(i in 2002:2017){train[[i-2001]]<-dataset(season %>%
filter(YEAR %in% c(i,i+1))) %>%
filter(PA_y1>99)}
train <- do.call(rbind.data.frame, train) %>%
select(-ends_with('_y2')) %>%
na.omit()
# submission 에서 가장 직전 년도에 99타석 이상 친 선수들의 직전년도
validation <- season %>% filter(batter_id %in% stan_Trial2$batter_id) %>%
dataset %>%
dplyr::select(-ends_with('_y2')) %>%
na.omit()
nm1 <- names(train)[4:ncol(train)]
# train 데이터
dtrain <- xgb.DMatrix(data.matrix(train[,nm1]),
label = train$OPS_y,
weight = train$AB_y1)
# Random search for parameters
best_param <- list()
best_seednumber <- 1234
best_rmse <- Inf
best_rmse_index <- 0
for (iter in 1:10) { # 업로드를 위해 반복을 2번만
param <- list(objective = "reg:linear",
eval_metric = "rmse",
max_depth = sample(6:10, 1),
eta = runif(1, .01, .3),
subsample = runif(1, .6, .9),
colsample_bytree = runif(1, .5, .8),
min_child_weight = sample(1:40, 1),
max_delta_step = sample(1:10, 1)
)
cv.nround <- 2000
cv.nfold <- 5
seed.number <- sample.int(10000, 1)
set.seed(seed.number)
mdcv <- xgboost::xgb.cv(data = dtrain, params = param,
nfold = cv.nfold, nrounds = cv.nround,
verbose = F, early_stopping_rounds = 30, maximize = FALSE)
min_rmse_index <- mdcv$best_iteration
min_rmse <- mdcv$evaluation_log[min_rmse_index]$test_rmse_mean
if (min_rmse < best_rmse) {
best_rmse <- min_rmse
best_rmse_index <- min_rmse_index
best_seednumber <- seed.number
best_param <- param
}
}
nround = best_rmse_index
set.seed(best_seednumber)
xg_model1_Trial2 <- xgboost(data = dtrain,
params = best_param,
nround = nround,
verbose = F,
print_every_n = 50)
# XGB2 : 1개년도 사용해서 100타석 이하(AB_y1 weight)----
train <- list()
for(i in 2002:2017){train[[i-2001]] <- dataset(season %>%
filter(YEAR %in% c(i, i+1))) %>%
filter(AB_y1<100)}
train <- do.call(rbind.data.frame,train) %>%
select(-ends_with('_y2')) %>%
na.omit()
nm1 <- names(train)[4:ncol(train)]
# Train 데이터
dtrain <- xgb.DMatrix(data.matrix(train[,nm1]),
label = train$OPS_y,
weight = train$AB_y1)
# Random Search for parameters
best_param <- list()
best_seednumber <- 1234
best_rmse <- Inf
best_rmse_index <- 0
for (iter in 1:2) { # 업로드를 위해 반복을 2번만
param <- list(objective = "reg:linear",
eval_metric = "rmse",
max_depth = sample(6:10, 1),
eta = runif(1, .01, .3),
subsample = runif(1, .6, .9),
colsample_bytree = runif(1, .5, .8),
min_child_weight = sample(1:40, 1),
max_delta_step = sample(1:10, 1)
)
cv.nround <- 2000
cv.nfold <- 5
seed.number <- sample.int(10000, 1)
set.seed(seed.number)
mdcv <- xgb.cv(data = dtrain,
params = param,
nfold = cv.nfold,
nrounds = cv.nround,
verbose = F,
early_stopping_rounds = 30,
maximize = FALSE)
min_rmse_index <- mdcv$best_iteration
min_rmse <- mdcv$evaluation_log[min_rmse_index]$test_rmse_mean
if (min_rmse < best_rmse) {
best_rmse <- min_rmse
best_rmse_index <- min_rmse_index
best_seednumber <- seed.number
best_param <- param
}
}
nround = best_rmse_index
set.seed(best_seednumber)
xg_model2_Trial2 <- xgboost(data = dtrain,
params = best_param,
nround = nround,
verbose = F,
print_every_n = 50)
# Feature Importance
xgb.ggplot.importance(xgb.importance(model=xg_model1_Trial2))
xgb.ggplot.importance(xgb.importance(model=xg_model2_Trial2))